home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / picsub.bas < prev    next >
Encoding:
BASIC Source File  |  1989-08-20  |  2.7 KB  |  92 lines
  1.  
  2.     OPENFILE
  3. 001 SUBROUTINE (DICT,NAME,FV)
  4. 002 *OPEN A FILE;FIND LOCKS
  5. 003 *2/3/86 JF3
  6. 004 IF DICT="L" THEN
  7. 005   DICT="DICT";GOSUB 4;IF FLAG THEN DICT=-1;GO 2
  8. 006   CALL READITEM(0,"DICT ":NAME,FV,0,"F/LOCK",ITEM,FLAG)
  9. 007   IF FLAG AND ITEM<1>="A" THEN LOCK.ATTR=ITEM<2> ELSE LOCK.ATTR=0
  10. 008   DICT=""
  11. 009 END ELSE LOCK.ATTR=0
  12. 010 GOSUB 4;IF FLAG THEN DICT=-1 ELSE DICT=LOCK.ATTR
  13. 011 2 RETURN;*TO CALLER
  14. 012 4 FLAG=0;OPEN DICT,NAME TO FV ELSE
  15. 013   OPEN "","ERRFILE" TO FV ELSE PRINT "NO ERRFILE!";INPUT NAME;STOP
  16. 014   IF DICT#"" THEN DICT=DICT:" "
  17. 015   CALL PERR(0,0,FV,19,DICT:NAME);FLAG=1
  18. 016 END;RETURN;END
  19. 017 * * * * * Interface Info * * * * *
  20. 018 *
  21. 019 *         DICT             NAME        FV
  22. 020 *         ____             ____        __
  23. 021 *Entry:   nul
  24. 022 *         L                filename
  25. 023 *         DICT
  26. 024 *
  27. 025 *Exit:
  28. 026 * IF L    lock-attr#:=open w/locking
  29. 027 *         -1:=        no open, error
  30. 028 * else
  31. 029 *
  32. 030 * nul|    -1
  33. 031 *         0
  34.  
  35.     BXTD
  36. 001 SUBROUTINE (N)
  37. 002 *CONVERT HEX STRING TO DECIMAL
  38. 003 *5/22/84 JF3
  39. 004 d=0;i=1;LOOP c=N[i,1] UNTIL c="" DO
  40. 005   d=d*16;IF c>"@" THEN c=SEQ(c)-55
  41. 006   d=d+c
  42. 007 i=i+1;REPEAT;N=d;RETURN
  43. 008 * * * * * Interface Info * * * * *
  44. 009 *Entry: N := Hex number as a char string
  45. 010 *
  46. 011 *Exit:  N := equivalent number (decimal)
  47. 012 END
  48.  
  49.     PERR
  50. 001 SUBROUTINE (C,R,F,ID,RESP)
  51. 002 *GENERAL ERROR MESSAGE SUBROUTINE
  52. 003 *10/11/85 JF3
  53. 004 EQU VM TO CHAR(253),PARAM TO RESP,CRTFUNC TO "U51A5"
  54. 005 PRINTER.WAS.ON=SYSTEM(1);PRINTER OFF;*SAVE PRINTER ON/OFF STATUS
  55. 006 CALL GTRMCHR(ITEM);EOL=ITEM<1,3>
  56. 007 IF R OR C THEN OMSG=@(C,R):EOL ELSE OMSG=""
  57. 008 READV MSG FROM F,ID,2 ELSE MSG="NO '":ID:"' IN ERRFILE!"
  58. 009 IF NUM(ID[1,1]) THEN OMSG=OMSG:CHAR(7)
  59. 010 I=1;J=1;LOOP SEG=FIELD(MSG,VM,I) UNTIL COL2()=0 DO
  60. 011   IF SEG="" THEN SEG=PARAM<1,J>;J=J+1
  61. 012   IF SEG[1,1]='@' THEN
  62. 013     SEG=OCONV(SEG<1,1,1>,CRTFUNC):SEG<1,1,2>
  63. 014   END;OMSG=OMSG:SEG
  64. 015 I=I+1;REPEAT;PRINT OMSG:
  65. 016 OMSG=ID[1,1];IF NUM(OMSG) OR OMSG="P" THEN
  66. 017   INPUT RESP:;IF R OR C THEN PRINT @(C,R):EOL:
  67. 018 END;IF PRINTER.WAS.ON THEN PRINTER ON
  68. 019 RETURN;END
  69.  
  70.     GTRMCHR
  71. 001 SUBROUTINE (chrstr)
  72. 002 *SHARE TERMINAL CHARACTERISTICS STRING
  73. 003 *6/19/87 JF3
  74. 004 *]OPENFILE]PERR
  75. 005 EQU ERRFILE TO chrstr,VM TO CHAR(253)
  76. 006 chrstr=@(-1):VM:@(-3):VM:@(-4)
  77. 007 chrstr<4>=SYSTEM(2):",":SYSTEM(3)
  78. 008 IF chrstr="" THEN
  79. 009   CALL OPENFILE("","ERRFILE",ERRFILE)
  80. 010   CALL PERR(0,0,ERRFILE,"A1",0)
  81. 011 END;RETURN
  82. 012 * * * * * Interface info * * * * *
  83. 013 *Entry:  none
  84. 014 *
  85. 015 *Exit:  chrstr := dynamic array of CRT control codes
  86. 016 *             <1,1> = clear screen and home
  87. 017 *             <1,2> = erase to end of page
  88. 018 *             <1,3> = erase to end of line
  89. 019 *             <4>   = arg string for TERM verb at TCL
  90. 020 END
  91.  
  92.